home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #2 / Monster Media No. 2 (Monster Media)(1994).ISO / utils2 / pgpsort.zip / PGPSORT.PAS < prev   
Pascal/Delphi Source File  |  1994-05-27  |  13KB  |  401 lines
  1. program PGPSort;
  2.  
  3. {                                                                           }
  4. { PGPSORT v1.02 by Ståle Schumacher/Felix Softworks 1994                    }
  5. {                                                                           }
  6. { Syntax  : PGPSORT [-KeyID|-UserID|-Size|-Date] [<keyring>]                }
  7. {                                                                           }
  8. { Synopsis: Sorts PGP public key rings.                                     }
  9. {                                                                           }
  10. { History : v1.02 - Now sorts keyIDs according to last 32 bits (was 24)     }
  11. {           v1.01 - Improved sorting of 'unstandard' user IDs               }
  12. {           v1.00 - Original version                                        }
  13. {                                                                           }
  14. { Examples: PGPSORT                    - Sorts your main public key ring    }
  15. {                                        (PUBRING.PGP) according to the     }
  16. {                                        user IDs on the keys               }
  17. {           PGPSORT -Date PUBRING2.PGP - Sorts the key ring PUBRING2.PGP    }
  18. {                                        according to the date of creation  }
  19. {                                        of the keys                        }
  20. {                                                                           }
  21. { The files PGPSORT.PAS and PGPSORT.EXE are placed in the public domain and }
  22. { may be freely distributed and modified. Any questions should be addressed }
  23. { to the author at:                                                         }
  24. {                                                                           }
  25. {                 Internet       : staalesc@ifi.uio.no                      }
  26. {                                                                           }
  27. {                 SoundServer BBS: +47 22 57 16 00                          }
  28. {                                  Ståle Schumacher                         }
  29. {                                                                           }
  30. {                 Snail mail     : Ståle Schumacher                         }
  31. {                                  Gyldenlovesgate 24                       }
  32. {                                  N-0260 Oslo                              }
  33. {                                  NORWAY                                   }
  34. {                                                                           }
  35.  
  36. {$A+,B-}
  37. {$M 32768,0,655360}
  38.  
  39. uses
  40.   Dos;
  41.  
  42. const
  43.   Version      = '1.02';
  44.   RevisionDate = '1994/05/27';
  45.  
  46.   MaxKeys      = 10000;
  47.  
  48. type
  49.   KeyPtr = ^KeyRec;
  50.   KeyRec = record
  51.              fPos,
  52.              length    : longint;
  53.              keyID     : longint;
  54.              userID    : string[25];
  55.              size      : integer;
  56.              date      : longint;
  57.            end;
  58.  
  59. var
  60.   SortCriterion: (KeyID,UserID,Size,Date);
  61.   keys         : integer;
  62.   key          : array[0..MaxKeys] of KeyPtr;
  63.  
  64. procedure Error(const msg: string);
  65.   begin
  66.     WriteLn(msg);
  67.     Halt(1);
  68.   end;
  69.  
  70. function FileExists(const fileName: PathStr): boolean;
  71.   var
  72.     DirInfo: SearchRec;
  73.   begin
  74.     FindFirst(fileName,Archive,DirInfo);
  75.     FileExists:=(DosError=0) and (fileName<>'');
  76.   end;
  77.  
  78. function NoDirInName(const fileName: PathStr): boolean;
  79.   var
  80.     i: Integer;
  81.   begin
  82.     NoDirInName:=True;
  83.     for i:=1 to Length(fileName) do
  84.       if fileName[i] in [':','\'] then
  85.         NoDirInName:=False;
  86.   end;
  87.  
  88. function DirWithSlash(const dir: DirStr): DirStr;
  89.   begin
  90.     if (dir<>'') and (Copy(dir,Length(dir),1)<>'\') then
  91.       DirWithSlash:=dir+'\'
  92.     else
  93.       DirWithSlash:=dir;
  94.   end;
  95.  
  96. function UpperCase(s: string): string; near; assembler;
  97.   asm
  98.     PUSH    DS
  99.     LDS     SI,[BP+4]
  100.     LES     DI,[BP+8]
  101.     CLD
  102.     LODSB
  103.     STOSB
  104.     XOR     CH,CH
  105.     MOV     CL,AL
  106.     JCXZ    @3
  107.   @1:
  108.     LODSB
  109.     CMP     AL,'a'
  110.     JB      @2
  111.     CMP     AL,'z'
  112.     JA      @2
  113.     SUB     AL,'a'-'A'
  114.   @2:
  115.     STOSB
  116.     LOOP    @1
  117.   @3:
  118.     POP     DS
  119.   end;
  120.  
  121. procedure QuickSort;
  122.  
  123.   function Sorted(a,b: integer): boolean;
  124.     begin
  125.       case SortCriterion of
  126.         KeyID : if (key[a]^.keyID < 0) and (key[b]^.keyID > 0) then
  127.                   Sorted:=false
  128.                 else if (key[a]^.keyID > 0) and (key[b]^.keyID < 0) then
  129.                   Sorted:=true
  130.                 else
  131.                   Sorted := key[a]^.keyID < key[b]^.keyID;
  132.         UserID: Sorted := key[a]^.userID < key[b]^.userID;
  133.         Size  : Sorted := key[a]^.size < key[b]^.size;
  134.         Date  : Sorted := key[a]^.date < key[b]^.date;
  135.       end;
  136.     end;
  137.  
  138.   procedure SwapKeys(a,b: integer);
  139.     var
  140.       x: KeyPtr;
  141.     begin
  142.       x:=key[a];
  143.       key[a]:=key[b];
  144.       key[b]:=x;
  145.     end;
  146.  
  147.   procedure Sort(left,right: integer);
  148.     var
  149.       i,j: integer;
  150.     begin
  151.       i:=left; j:=right;
  152.       key[0]^:=key[(left+right) div 2]^;
  153.       repeat
  154.         while Sorted(i,0) do
  155.           inc(i);
  156.         while Sorted(0,j) do
  157.           dec(j);
  158.         if i<=j then
  159.           begin
  160.             SwapKeys(i,j);
  161.             inc(i); dec(j);
  162.           end;
  163.       until i>j;
  164.       if left<j then
  165.         Sort(left,j);
  166.       if i<right then
  167.         Sort(i,right);
  168.     end;
  169.  
  170.   begin
  171.     Sort(1,keys);
  172.   end;
  173.  
  174. procedure SortKeyRing(const keyRing: PathStr);
  175.   const
  176.     LengthArray: array[0..3] of byte = (1,2,4,0);
  177.   var
  178.     f,newF            : file;
  179.     i,j,b,
  180.     CTB,
  181.     LengthOfLength    : byte;
  182.     PacketLength,
  183.     timeStamp,fPos    : longint;
  184.     bits              : word;
  185.     KeyID             : longInt;
  186.     UserID            : string;
  187.     junk              : string[2];
  188.     firstUserID       : boolean;
  189.     dir               : DirStr;
  190.     name              : NameStr;
  191.     ext               : ExtStr;
  192.     buf               : array[1..2048] of byte;
  193.     bakName           : string;
  194.     bytes             : integer;
  195.   begin
  196.     keys:=0;
  197.     fPos:=0;
  198.     GetMem(key[0],SizeOf(KeyRec));
  199.     Assign(f,KeyRing); Reset(f,1);
  200.     while fPos<FileSize(f) do
  201.       begin
  202.         Seek(f,fPos);
  203.         BlockRead(f,CTB,1);
  204.         LengthOfLength:=CTB and 3;
  205.         LengthOfLength:=LengthArray[LengthOfLength];
  206.         CTB:=CTB and 60;
  207.  
  208.         if CTB=24 then          {Public key packet}
  209.           begin
  210.             inc(keys);
  211.             if keys>MaxKeys then
  212.               Error('The keyring '+keyRing+' is too long to sort.');
  213.             GetMem(key[keys],SizeOf(KeyRec));
  214.             if key[keys]=nil then
  215.               Error('The keyring '+keyRing+' is too long to sort.');
  216.             key[keys]^.fPos:=fpos;
  217.             key[keys-1]^.length:=fpos-key[keys-1]^.fPos;
  218.             firstUserID:=true;
  219.             PacketLength:=0;
  220.             for i:=1 to LengthOfLength do
  221.               begin
  222.                 BlockRead(f,b,1);
  223.                 PacketLength:=(PacketLength shl 8)+b;
  224.               end;
  225.             BlockRead(f,junk,1);
  226.             BlockRead(f,b,1); TimeStamp:=b;
  227.             BlockRead(f,b,1); TimeStamp:=(TimeStamp shl 8) or b;
  228.             BlockRead(f,b,1); TimeStamp:=(TimeStamp shl 8) or b;
  229.             BlockRead(f,b,1); TimeStamp:=(TimeStamp shl 8) or b;
  230.             BlockRead(f,junk,3);
  231.             BlockRead(f,Bits,2); bits:=Swap(bits);
  232.               Seek(f,FilePos(f)+((bits+7) div 8)-4);
  233.             BlockRead(f,b,1); keyID:=b;
  234.             BlockRead(f,b,1); keyID:=(keyID shl 8) or b;
  235.             BlockRead(f,b,1); keyID:=(keyID shl 8) or b;
  236.             BlockRead(f,b,1); keyID:=(keyID shl 8) or b;
  237.             key[keys]^.size :=bits;
  238.             key[keys]^.keyID:=keyID;
  239.             key[keys]^.date :=TimeStamp;
  240.             fPos:=fPos+LengthOfLength+PacketLength+1;
  241.           end
  242.         else if CTB=52 then     {User ID packet}
  243.           begin
  244.             PacketLength:=0;
  245.             BlockRead(f,PacketLength,1);
  246.             Seek(f,FilePos(f)-1);
  247.             BlockRead(f,UserID,PacketLength+1);
  248.             UserID:=UpperCase(UserID);
  249.             if firstUserID then
  250.               begin
  251.                 firstUserID:=false;
  252.                 b:=1;
  253.                 while (b<=Length(UserID)) and
  254.                 not (((UserID[b] in ['0'..'9']) and (UserID[b-1]<>'-'))
  255.                      or (UserID[b] in ['[','<','(','+'])
  256.                      or (Copy(UserID,b,2)='- ')) do
  257.                   inc(b);
  258.                 UserID[0]:=CHAR(b-1);
  259.                 while Copy(UserID,Length(UserID),1)=' ' do dec(UserID[0]);
  260.  
  261.                 {Derive name from internet address?}
  262.                 if (Pos(' ',UserID)=0) and (Pos('@',UserID)>0) then
  263.                   begin
  264.                     UserID[0]:=char(Pos('@',UserID)-1);
  265.                     b:=Pos('.',UserID);
  266.                     if b>0 then UserID[b]:=' ';
  267.                   end;
  268.  
  269.                 {Split first and last names}
  270.                 if Pos(' ',UserID)=0 then
  271.                   key[keys]^.userID:=UserID
  272.                 else
  273.                   begin
  274.                     b:=Pos(', ',UserID);
  275.                     if (b>0) and (b+1=Pos(' ',UserID)) then
  276.                       key[keys]^.userID:=UserID
  277.                     else
  278.                       begin
  279.                         b:=Length(UserID);
  280.                         while (UserID[b]<>' ') do dec(b);
  281.                         key[keys]^.userID:=Copy(UserID,b+1,Length(UserID))+', '+Copy(UserID,1,b-1);
  282.                       end;
  283.                   end;
  284.               end;
  285.             fPos:=fPos+PacketLength+2;
  286.           end
  287.         else if CTB=48 then     {Keyring trust packet}
  288.           fPos:=fPos+3
  289.         else if CTB=8 then      {Signature packet}
  290.           begin
  291.             PacketLength:=0;
  292.             for i:=1 to LengthOfLength do
  293.               begin
  294.                 BlockRead(f,b,1);
  295.                 PacketLength:=(PacketLength SHL 8)+b;
  296.               end;
  297.             fPos:=fPos+LengthOfLength+PacketLength+1;
  298.           end
  299.         else                    {Unknown packet}
  300.           Error(keyRing+' is not a public key ring.');
  301.       end;
  302.     key[keys]^.length:=FileSize(f)-key[keys]^.fPos;
  303.     Close(f);
  304.     if keys=0 then
  305.       Error(keyRing+' is not a public key ring.');
  306.  
  307.     {Sort keys}
  308.     QuickSort;
  309.  
  310.     {Backup old keyring}
  311.     FSplit(KeyRing,Dir,Name,Ext);
  312.     bakName:=Dir+Name+'.BAK';
  313.     Assign(f,bakName); {$I-} Erase(f); {$I+}
  314.     if IOResult<>0 then {Old backup not found};
  315.     Assign(f,KeyRing); Rename(f,bakName);
  316.  
  317.     {Generate new keyring}
  318.     Assign(f,bakName); Reset(f,1);
  319.     Assign(newF,KeyRing); Rewrite(newF,1);
  320.     for i:=1 to keys do
  321.       begin
  322.         Seek(f,key[i]^.fPos);
  323.         while key[i]^.length>0 do
  324.           begin
  325.             bytes:=key[i]^.length; if bytes>SizeOf(buf) then bytes:=SizeOf(buf);
  326.             BlockRead(f,buf,bytes);
  327.             BlockWrite(newF,buf,bytes);
  328.             dec(key[i]^.length,bytes);
  329.           end;
  330.       end;
  331.     Close(f); Close(newF);
  332.  
  333.     for i:=0 to keys do
  334.       FreeMem(key[i],SizeOf(KeyRec));
  335.   end;
  336.  
  337. procedure WriteSyntax;
  338.   begin
  339.     WriteLn('Syntax: PGPSORT [-KeyID|-UserID|-Size|-Date] [<keyring>]');
  340.     Halt(1);
  341.   end;
  342.  
  343. var
  344.   i      : integer;
  345.   mode,
  346.   KeyRing: string;
  347.  
  348. begin
  349.   WriteLn;
  350.   WriteLn('PGPSORT v',Version,' (C) 1994 Felix Softworks');
  351.   WriteLn('Written by Ståle Schumacher ',RevisionDate);
  352.   WriteLn;
  353.  
  354.   KeyRing:='PUBRING.PGP';
  355.   SortCriterion:=UserID;
  356.   if ParamCount in [1,2] then
  357.     begin
  358.       mode:=UpperCase(ParamStr(1));
  359.       if mode='-KEYID' then
  360.         SortCriterion:=KeyID
  361.       else if mode='-USERID' then
  362.         SortCriterion:=UserID
  363.       else if mode='-SIZE' then
  364.         SortCriterion:=Size
  365.       else if mode='-DATE' then
  366.         SortCriterion:=Date
  367.       else if Copy(mode,1,1)='-' then
  368.         WriteSyntax
  369.       else if ParamCount=2 then
  370.         WriteSyntax
  371.       else
  372.         KeyRing:=UpperCase(ParamStr(1));
  373.       if ParamCount=2 then
  374.         begin
  375.           KeyRing:=UpperCase(ParamStr(2));
  376.           if Copy(KeyRing,1,1)='-' then
  377.             WriteSyntax;
  378.         end
  379.     end
  380.   else if ParamCount<>0 then
  381.     WriteSyntax;
  382.  
  383.   if not FileExists(KeyRing) then
  384.     begin
  385.       if NoDirInName(KeyRing) then
  386.         KeyRing:=DirWithSlash(UpperCase(GetEnv('PGPPATH')))+KeyRing;
  387.       if not FileExists(KeyRing) then
  388.         Error(KeyRing+' not found.');
  389.     end;
  390.  
  391.   SortKeyRing(KeyRing);
  392.  
  393.   Write(KeyRing,' sorted on ');
  394.   case SortCriterion of
  395.     KeyID : WriteLn('key ID.');
  396.     UserID: WriteLn('user ID.');
  397.     Size  : WriteLn('size.');
  398.     Date  : WriteLn('date.');
  399.   end;
  400. end.
  401.